home *** CD-ROM | disk | FTP | other *** search
/ ADA Programming Guide / ADA Programming Guide.iso / ada_gnu / adainc / a-stwise.adb < prev    next >
Text File  |  1996-01-30  |  9KB  |  321 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT RUNTIME COMPONENTS                          --
  4. --                                                                          --
  5. --              A D A . S T R I N G S . W I D E _ S E A R C H               --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.5 $                              --
  10. --                                                                          --
  11. --           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
  12. --                                                                          --
  13. -- The GNAT library is free software; you can redistribute it and/or modify --
  14. -- it under terms of the GNU Library General Public License as published by --
  15. -- the Free Software  Foundation; either version 2, or (at your option) any --
  16. -- later version.  The GNAT library is distributed in the hope that it will --
  17. -- be useful, but WITHOUT ANY WARRANTY;  without even  the implied warranty --
  18. -- of MERCHANTABILITY  or  FITNESS FOR  A PARTICULAR PURPOSE.  See the  GNU --
  19. -- Library  General  Public  License for  more  details.  You  should  have --
  20. -- received  a copy of the GNU  Library  General Public License  along with --
  21. -- the GNAT library;  see the file  COPYING.LIB.  If not, write to the Free --
  22. -- Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.        --
  23. --                                                                          --
  24. ------------------------------------------------------------------------------
  25.  
  26. --  Note: This code is derived from the ADAR.CSH public domain Ada 83
  27. --  versions of the Appendix C string handling packages (code extracted
  28. --  from Ada.Strings.Fixed). A significant change is that we optimize the
  29. --  case of identity mappings for Count and Index, and also Index_Non_Blank
  30. --  is specialized (rather than using the general Index routine).
  31.  
  32. with Ada.Characters;
  33. with Ada.Strings.Wide_Maps; use Ada.Strings.Wide_Maps;
  34.  
  35. package body Ada.Strings.Wide_Search is
  36.  
  37.    -----------------------
  38.    -- Local Subprograms --
  39.    -----------------------
  40.  
  41.    function Belongs
  42.      (Element : Wide_Character;
  43.       Set     : Wide_Maps.Wide_Character_Set;
  44.       Test    : Membership)
  45.       return    Boolean;
  46.    pragma Inline (Belongs);
  47.    --  Determines if the given element is in (Test = Inside) or not in
  48.    --  (Test = Outside) the given character set.
  49.  
  50.    -------------
  51.    -- Belongs --
  52.    -------------
  53.  
  54.    function Belongs
  55.      (Element : Wide_Character;
  56.       Set     : Wide_Maps.Wide_Character_Set;
  57.       Test    : Membership)
  58.       return    Boolean is
  59.    begin
  60.       if Test = Inside then
  61.          return Is_In (Element, Set);
  62.       else
  63.          return not Is_In (Element, Set);
  64.       end if;
  65.    end Belongs;
  66.  
  67.    -----------
  68.    -- Count --
  69.    -----------
  70.  
  71.    function Count
  72.      (Source   : in Wide_String;
  73.       Pattern  : in Wide_String;
  74.       Mapping  : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
  75.       return     Natural
  76.    is
  77.       N : Natural;
  78.       J : Natural;
  79.  
  80.    begin
  81.       --  Handle the case of non-identity mappings by creating a mapped
  82.       --  string and making a recursive call using the identity mapping
  83.       --  on this mapped string.
  84.  
  85.       if Mapping /= Wide_Maps.Identity then
  86.          declare
  87.             Mapped_Source : Wide_String (Source'Range);
  88.  
  89.          begin
  90.             for J in Source'Range loop
  91.                Mapped_Source (J) := Value (Mapping, Source (J));
  92.             end loop;
  93.  
  94.             return Count (Mapped_Source, Pattern);
  95.          end;
  96.       end if;
  97.  
  98.       if Pattern = "" then
  99.          raise Pattern_Error;
  100.       end if;
  101.  
  102.       N := 0;
  103.       J := Source'First;
  104.  
  105.       while J <= Source'Last - (Pattern'Length - 1) loop
  106.          if Source (J .. J + (Pattern'Length - 1)) = Pattern then
  107.             N := N + 1;
  108.             J := J + Pattern'Length;
  109.          else
  110.             J := J + 1;
  111.          end if;
  112.       end loop;
  113.  
  114.       return N;
  115.    end Count;
  116.  
  117.    function Count
  118.      (Source   : in Wide_String;
  119.       Pattern  : in Wide_String;
  120.       Mapping  : in Wide_Maps.Wide_Character_Mapping_Function)
  121.       return     Natural
  122.    is
  123.       Mapped_Source : Wide_String (Source'Range);
  124.  
  125.    begin
  126.       for J in Source'Range loop
  127.          Mapped_Source (J) := Mapping (Source (J));
  128.       end loop;
  129.  
  130.       return Count (Mapped_Source, Pattern);
  131.    end Count;
  132.  
  133.    function Count (Source : in Wide_String;
  134.                    Set    : in Wide_Maps.Wide_Character_Set)
  135.      return Natural
  136.    is
  137.       N : Natural := 0;
  138.  
  139.    begin
  140.       for J in Source'Range loop
  141.          if Is_In (Source (J), Set) then
  142.             N := N + 1;
  143.          end if;
  144.       end loop;
  145.  
  146.       return N;
  147.    end Count;
  148.  
  149.    ----------------
  150.    -- Find_Token --
  151.    ----------------
  152.  
  153.    procedure Find_Token
  154.      (Source : in Wide_String;
  155.       Set    : in Wide_Maps.Wide_Character_Set;
  156.       Test   : in Membership;
  157.       First  : out Positive;
  158.       Last   : out Natural)
  159.    is
  160.    begin
  161.       for J in Source'Range loop
  162.          if Belongs (Source (J), Set, Test) then
  163.             First := J;
  164.  
  165.             for K in J + 1 .. Source'Last loop
  166.                if not Belongs (Source (K), Set, Test) then
  167.                   Last := K - 1;
  168.                   return;
  169.                end if;
  170.             end loop;
  171.  
  172.             --  Here if J indexes 1st char of token, and all chars
  173.             --  after J are in the token
  174.  
  175.             Last := Source'Last;
  176.             return;
  177.          end if;
  178.       end loop;
  179.  
  180.       --  Here if no token found
  181.  
  182.       First := Source'First;
  183.       Last  := 0;
  184.    end Find_Token;
  185.  
  186.    -----------
  187.    -- Index --
  188.    -----------
  189.  
  190.    function Index
  191.      (Source   : in Wide_String;
  192.       Pattern  : in Wide_String;
  193.       Going    : in Direction := Forward;
  194.       Mapping  : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
  195.       return     Natural
  196.    is
  197.    begin
  198.       --  Handle the case of non-identity mappings by creating a mapped
  199.       --  string and making a recursive call using the identity mapping
  200.       --  on this mapped string.
  201.  
  202.       if Mapping /= Identity then
  203.          declare
  204.             Mapped_Source : Wide_String (Source'Range);
  205.  
  206.          begin
  207.             for J in Source'Range loop
  208.                Mapped_Source (J) := Value (Mapping, Source (J));
  209.             end loop;
  210.  
  211.             return Index (Mapped_Source, Pattern, Going);
  212.          end;
  213.       end if;
  214.  
  215.       if Pattern = "" then
  216.          raise Pattern_Error;
  217.       end if;
  218.  
  219.       if Going = Forward then
  220.          for J in 1 .. Source'Length - Pattern'Length + 1 loop
  221.             if Pattern = Source (J .. J + Pattern'Length - 1) then
  222.                return J + Source'First - 1;
  223.             end if;
  224.          end loop;
  225.  
  226.       else -- Going = Backward
  227.          for J in reverse 1 .. Source'Length - Pattern'Length + 1 loop
  228.             if Pattern = Source (J .. J + Pattern'Length - 1) then
  229.                return J + Source'First - J;
  230.             end if;
  231.          end loop;
  232.       end if;
  233.  
  234.       --  Fall through if no match found. Note that the loops are skipped
  235.       --  completely in the case of the pattern being longer than the source.
  236.  
  237.       return 0;
  238.    end Index;
  239.  
  240.    -----------
  241.    -- Index --
  242.    -----------
  243.  
  244.    function Index
  245.      (Source   : in Wide_String;
  246.       Pattern  : in Wide_String;
  247.       Going    : in Direction := Forward;
  248.       Mapping  : in Wide_Maps.Wide_Character_Mapping_Function)
  249.       return     Natural
  250.    is
  251.       Mapped_Source : Wide_String (Source'Range);
  252.  
  253.    begin
  254.       for J in Source'Range loop
  255.          Mapped_Source (J) := Mapping (Source (J));
  256.       end loop;
  257.  
  258.       return Index (Mapped_Source, Pattern, Going);
  259.    end Index;
  260.  
  261.    function Index
  262.      (Source : in Wide_String;
  263.       Set    : in Wide_Maps.Wide_Character_Set;
  264.       Test   : in Membership := Inside;
  265.       Going  : in Direction  := Forward)
  266.       return   Natural
  267.    is
  268.    begin
  269.       if Going = Forward then
  270.          for J in Source'Range loop
  271.             if Belongs (Source (J), Set, Test) then
  272.                return J;
  273.             end if;
  274.          end loop;
  275.  
  276.       else -- Going = Backward
  277.          for J in reverse Source'Range loop
  278.             if Belongs (Source (J), Set, Test) then
  279.                return J;
  280.             end if;
  281.          end loop;
  282.       end if;
  283.  
  284.       --  Fall through if no match
  285.  
  286.       return 0;
  287.    end Index;
  288.  
  289.    ---------------------
  290.    -- Index_Non_Blank --
  291.    ---------------------
  292.  
  293.    function Index_Non_Blank
  294.      (Source : in Wide_String;
  295.       Going  : in Direction := Forward)
  296.       return   Natural
  297.    is
  298.    begin
  299.       if Going = Forward then
  300.          for J in Source'Range loop
  301.             if Source (J) /= ' ' then
  302.                return J;
  303.             end if;
  304.          end loop;
  305.  
  306.       else -- Going = Backward
  307.          for J in reverse Source'Range loop
  308.             if Source (J) /= ' ' then
  309.                return J;
  310.             end if;
  311.          end loop;
  312.       end if;
  313.  
  314.       --  Fall through if no match
  315.  
  316.       return 0;
  317.  
  318.    end Index_Non_Blank;
  319.  
  320. end Ada.Strings.Wide_Search;
  321.